--------------------------------------------------------------------------------
-- This package is a thick Ada binding to the GNU Multiple Precision Library.
-- See <http://gmplib.org/>.
--
-- Copyright (C) 2009 Vincent DIEMUNSCH.
-- GNU General Public License.
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU General Public License as published by the Free Software
-- Foundation, either version 3 of the License, or (at your option) any later
-- version.
--
-- This file is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-- A PARTICULAR PURPOSE. See the GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License along with
-- this program.  If not, see <http://www.gnu.org/licenses/>.
----------------------------------------------------------------------------------
--
-- This package declares a new private type : Unbounded_Fraction, that is an
-- abstraction of rational (common fraction) of arbitrary size.

with GMP.Integers.Aliased_Internal_Value;
package body GMP.Rationals is

   ---------
   -- "/" --
   ---------

   function "/" (Left, Right : Unbounded_Integer) return Unbounded_Fraction is
      mpq      : mpq_t;
      Right_Op : mpz_t := Aliased_Internal_Value(Right);
   begin
      if mpz_cmp_si(Right_Op, 0) = 0 then raise Constraint_Error; end if;
      mpq_init(mpq);
      mpq_set_num (mpq, Aliased_Internal_Value(Left));
      mpq_set_den (mpq, Right_Op);
      mpq_canonicalize(mpq);
      return (Ada.Finalization.Controlled with mpq);
   end "/";

   ---------------
   -- Numerator --
   ---------------

   function Numerator (F : Unbounded_Fraction) return Unbounded_Integer
   is
      Num : mpz_t;
   begin
      mpz_init(Num);
      mpq_get_num (Num, F.Value);
      return To_Unbounded_Integer(Num);
   end Numerator;

   -----------------
   -- Denominator --
   -----------------

   function Denominator (F : Unbounded_Fraction) return Unbounded_Integer
   is
      Den : mpz_t;
   begin
      mpz_init(Den);
      mpq_get_den (Den, F.Value);
      return To_Unbounded_Integer(Den);
   end Denominator;

   ---------
   -- "=" --
   ---------

   function "=" (Left, Right : Unbounded_Fraction) return Boolean is
   begin
      return (mpq_equal (Left.Value, Right.Value) /= 0);
   end "=";

   ---------
   -- "<" --
   ---------

   function "<" (Left, Right : Unbounded_Fraction) return Boolean is
   begin
      return (mpq_cmp(Left.Value, Right.Value) < 0);
   end "<";

   ----------
   -- "<=" --
   ----------

   function "<=" (Left, Right : Unbounded_Fraction) return Boolean is
   begin
      return (mpq_cmp(Left.Value, Right.Value) <= 0);
   end "<=";

   ---------
   -- ">" --
   ---------

   function ">" (Left, Right : Unbounded_Fraction) return Boolean is
   begin
      return (mpq_cmp(Left.Value, Right.Value) > 0);
   end ">";

   ----------
   -- ">=" --
   ----------

   function ">=" (Left, Right : Unbounded_Fraction) return Boolean is
   begin
      return (mpq_cmp(Left.Value, Right.Value) >= 0);
   end ">=";

   ---------
   -- "+" --
   ---------

   function "+" (Right : Unbounded_Fraction) return Unbounded_Fraction is
      mpq : mpq_t;
   begin
      mpq_init(mpq);
      mpq_set (mpq, Right.Value);
      return (Ada.Finalization.Controlled with mpq);
   end "+";

   ---------
   -- "-" --
   ---------

   function "-" (Right : Unbounded_Fraction) return Unbounded_Fraction is
      mpq : mpq_t;
   begin
      mpq_init(mpq);
      mpq_neg (mpq, Right.Value);
      return (Ada.Finalization.Controlled with mpq);
   end "-";

   -----------
   -- "abs" --
   -----------

   function "abs" (Right : Unbounded_Fraction) return Unbounded_Fraction is
      mpq : mpq_t;
   begin
      mpq_init(mpq);
      mpq_abs (mpq, Right.Value);
      return (Ada.Finalization.Controlled with mpq);
   end "abs";

   ---------
   -- "+" --
   ---------

   function "+" (Left, Right : Unbounded_Fraction) return Unbounded_Fraction
   is
      mpq : mpq_t;
   begin
      mpq_init(mpq);
      mpq_add (mpq, Left.Value, Right.Value);
      return (Ada.Finalization.Controlled with mpq);
   end "+";

   ---------
   -- "-" --
   ---------

   function "-" (Left, Right : Unbounded_Fraction) return Unbounded_Fraction
   is
      mpq : mpq_t;
   begin
      mpq_init(mpq);
      mpq_sub (mpq, Left.Value, Right.Value);
      return (Ada.Finalization.Controlled with mpq);
   end "-";

   ---------
   -- "*" --
   ---------

   function "*" (Left, Right : Unbounded_Fraction) return Unbounded_Fraction
   is
      mpq : mpq_t;
   begin
      mpq_init(mpq);
      mpq_mul (mpq, Left.Value, Right.Value);
      return (Ada.Finalization.Controlled with mpq);
   end "*";

   ---------
   -- "/" --
   ---------

   function "/" (Left, Right : Unbounded_Fraction) return Unbounded_Fraction
   is
      mpq : mpq_t;
   begin
      mpq_init(mpq);
      mpq_div (mpq, Left.Value, Right.Value);
      return (Ada.Finalization.Controlled with mpq);
   end "/";

   ---------
   -- inv --
   ---------

   function inv (Right : Unbounded_Fraction) return Unbounded_Fraction is
      mpq : mpq_t;
   begin
      mpq_init(mpq);
      mpq_inv (mpq, Right.Value);
      return (Ada.Finalization.Controlled with mpq);
   end inv;

   ----------
   -- "**" --
   ----------

   function "**" (Left  : Unbounded_Fraction;
                  Right : Integer'Base)
                  return Unbounded_Fraction
   is
      mpq      : mpq_t;
      Num, Den : mpz_t;
   begin
      mpq_init (mpq);
      mpz_init (Num);
      mpz_init (Den);
      if Right >= 0 then
         mpq_get_num (Num, Left.Value);
         mpq_get_den (Den, Left.Value);
      else
         mpq_get_num (Den, Left.Value);
         mpq_get_den (Num, Left.Value);    
      end if;
	  mpz_pow_ui (Num, Num, unsigned_long(abs Right));
	  mpz_pow_ui (Den, Den, unsigned_long(abs Right));
      mpq_set_num (mpq, Num);
      mpq_set_den (mpq, Den);
	  mpz_clear (Num);
	  mpz_clear (Den);
 
--   begin
--      mpq_init(mpq);
--      if Right /= 0 then
--         if Right < 0 then
--            Exp := - Right;
--            mpq_inv (mpq, Left.Value);
--         else
--            Exp := Right;
--            mpq_set (mpq, Left.Value);
--         end if;
--         for i in 1 .. Exp loop
---            mpq_mul(mpq, mpq, Left.Value);
--         end loop;
--      end if;

      return (Ada.Finalization.Controlled with mpq);
   end "**";

   ---------------------------
   -- To_Unbounded_Fraction --
   ---------------------------

   function To_Unbounded_Fraction (F : Fraction) return Unbounded_Fraction is
      mpq : mpq_t;
   begin
       -- F is supposed to be already canonicalized.
      mpq_init(mpq);
      mpq_set_si (mpq, long(Num(F)), unsigned_long(Den(F)));
      return (Ada.Finalization.Controlled with mpq);
   end To_Unbounded_Fraction;

   ---------
   -- "+" --
   ---------

   function "+" (Left : Unbounded_Fraction; Right : Fraction)
      return Unbounded_Fraction
   is begin
      return Left + To_Unbounded_Fraction (Right);
   end "+";

   ---------
   -- "-" --
   ---------

   function "-" (Left : Unbounded_Fraction; Right : Fraction)
                 return Unbounded_Fraction
   is begin
      return Left - To_Unbounded_Fraction (Right);
   end "-";

   ---------
   -- "-" --
   ---------

   function "-" (Left : Fraction; Right : Unbounded_Fraction)
                 return Unbounded_Fraction
   is begin
      return To_Unbounded_Fraction (Left) - Right;
   end "-";


   ---------
   -- "*" --
   ---------

   function "*" (Left : Unbounded_Fraction; Right : Fraction)
      return Unbounded_Fraction
   is
      mpq, mp_Right : mpq_t;
   begin
      -- Right is supposed to be already canonicalized.
      mpq_init(mpq);
      mpq_init(mp_Right);
      mpq_set_si (mp_Right, long(Num(Right)), unsigned_long(Den(Right)));
      mpq_mul(mpq, mpq, mp_Right);
      mpq_clear (mp_Right);
      return (Ada.Finalization.Controlled with mpq);
   end "*";

   ---------
   -- "/" --
   ---------

   function "/"  (Left : Unbounded_Fraction; Right : Fraction)
      return Unbounded_Fraction
   is
      mpq, mp_Right : mpq_t;
   begin
      -- Right is supposed to be already canonicalized.
      mpq_init(mpq);
      mpq_init(mp_Right);
      mpq_set_si (mp_Right, long(Num(Right)), unsigned_long(Den(Right)));
      mpq_div(mpq, mpq, mp_Right);
      mpq_clear (mp_Right);
      return (Ada.Finalization.Controlled with mpq);
   end "/";


   ---------
   -- "/" --
   ---------

   function "/" (Left : Fraction; Right : Unbounded_Fraction)
      return Unbounded_Fraction
   is
      mpq, mp_Left : mpq_t;
   begin
      -- Right is supposed to be already canonicalized.
      mpq_init (mpq);
      mpq_init (mp_Left);
      mpq_set_si (mp_Left, long(Num(Left)), unsigned_long(Den(Left)));
      mpq_div (mpq, mp_Left, mpq);
      mpq_clear (mp_Left);
      return (Ada.Finalization.Controlled with mpq);
   end "/";

   -----------
   -- Image --
   -----------

   function Image (Object : Unbounded_Fraction;
                   Base   : Base_Range := 10)
                   return String
   is
      -- This function use the Unbounded_Integer Image function and
      -- do not call mpq_set_str.
   begin
      return
        Image(Numerator  (Object), Base) & " / " &
        Image(Denominator(Object), Base);
   end Image;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (Object: in out Unbounded_Fraction) is
   begin
      mpq_init(Object.Value);
   end Initialize;

   ------------
   -- Adjust --
   ------------

   procedure Adjust (Object: in out Unbounded_Fraction) is
      mpq : mpq_t := Object.Value;
   begin
      mpq_init(Object.Value);
      mpq_set (Object.Value, mpq);
   end Adjust;

   --------------
   -- Finalize --
   --------------

   procedure Finalize (Object: in out Unbounded_Fraction) is
   begin
      mpq_clear(Object.Value);
   end Finalize;

end GMP.Rationals;
